home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d11
/
pscreen.arc
/
PS-DEMO.BAS
< prev
next >
Wrap
BASIC Source File
|
1989-07-07
|
18KB
|
411 lines
'*** PS-Demo.BAS *************************************(C) 1988 R.W. Smetana *
'
' Demo program included with P-Screen (Pro~Formance Screen Design).
'
' QuickBASIC 4.0 or later required to run this. TYPE & SEG used.
'
' 2 Purposes: Demonstrate how to:
' 1. Display screens stored in a Library.
' - Press [H]elp to view a Help Screen. Examine the
' small amount of code needed to display a screen.
' 2. Display a directory of Library Screen names.
'
' To run: Run QB, loading a Quick Library that contains:
' - rsLoadScrn -rsLodBin -rsScrnRest (optional)
'
' We include PS-DEMO.QLB with P-Screen for this purpose.
'
' Example: QB ps-demo /l ps-demo
'
' Compatibility: QuickBasic 4.0 + only (rsLoadScrn uses TYPE, here we use SEG)
'
' History: 1st cut 12/88
'
'****************************************************************************
DEFINT A-Z '... Integers ONLY. If not, called routines will crash.
'................. ................. ................. .................
DECLARE SUB LoadQB (QBMenu%(), QB.ErrCode%) '... included here; rest are in PS-Demo.Qlb
DECLARE SUB rsLoadScrn (Sc2%(), LibName$, FileName$, Desc$, TopRow%, TopCol%, BotRow%, BotCol%, x%, ErrCode%)
DECLARE SUB rsScrnRest (TopRow%, BotRow%, SEG Array%)
DECLARE SUB rsScrnRestPlus (SEG Sc1%, Top, Lft, Bot, Rht)
'...Caution: Use rsScrnRest ONLY for full-width screens. Registered users
' receive a Screen Restore subprogram useful for full/partial/sub screens.
' In place of rsScrnRest, use a screen restore subprogram you already have.
' But, it must be able to handle $Dynamic Integer arrays (see REdim below).
TYPE ScrLib '... TYPE to read Names/Descriptions
ScrName AS STRING * 8 ' of screens in a Library
Description AS STRING * 15
IgnoreMe AS STRING * 14
END TYPE
DIM ScreenLib AS ScrLib
'... If you prefer Field statements rather than TYPES
'... FIELD #1, 8 AS ScrName$, 15 AS Description$, 14 AS IgnoreMe$
'................. ................. ................. .................
LibName$ = "P-SCREEN" '... Display all screens from P-Screen.Psl
ON ERROR GOTO CantFindLibrary '... This demo aborts if P-Screen.Psl isn't found.
'... 1st, see if "P-Screen.Psl" exists. If not, stop.
CLOSE : OPEN LibName$ + ".Psl" FOR INPUT AS #1 '... Just checking. Your
CLOSE ' programs MUST ensure
' Libraries exist BEFORE
' calling our routines
REDIM QBMenu%(1) '... QBMenuDemo has Details
CALL LoadQB(QBMenu%(), QB.ErrCode) ' LoadQB is in PS-Demo.Qlb
'................. ................. ................. .................
'... Main Menu
DO
CLS
PRINT TAB(31); "P~F Screen Demo"
a$ = "Do you want: Help/Directory/QB Demo?" '... Help displays a Help Screen
b$ = "Press [H]elp, [D]irectory, [Q]B" '... Directory displays screens/descriptions
' in P-Screen.Psl. Both are useful.
' See QBDemo for details on it
c$ = "Esc] = Exit this Demo"
GOSUB MidMessage '... print the Main Menu
Option$ = UCASE$(INPUT$(1))
CLS
ON INSTR("HDQ", Option$) GOSUB Help, Directory, QBDemo '... do it or exit
LOOP WHILE Option$ <> CHR$(27)
END
'................. ................. ................. .................
Help: '... demonstrate how to Display Library Screen/interpret ErrCode
'................. ................. ................. .................
LibName$ = "P-Screen" '... P-Screen.Psl comes with P-Screen
ScreenName$ = "QUIKREF1" '... 1st P-Screen Help Screen
REDIM Array%(1) '... Load screen into Array%(), then
' restore screen from Array%(). Don't
' use Dim. It's REdimension as needed.
GOSUB DisplayScreen '... That's it. See below for how it's done
RETURN
'................. ................. ................. .................
DisplayScreen:
'... If we got here, LibName$ + ".Psl" is available. Load ScreenName$
'................. ................. ................. .................
LibName$ = UCASE$(LibName$)
ScreenName$ = UCASE$(ScreenName$) '... Screen names stored in Upper Case
CALL rsLoadScrn(Array%(), LibName$, ScreenName$, Desc$, TopRow, TopCol, BotRow, BotCol, x, ErrCode)
'... Notes: You needn't Open/Close
' the Library File. That's done in
' rsLoadScrn.
' TopRow/TopCol/BotRow/BotCol define
' the Original coordinates of the screen.
' (1/1/25/80 = Rows 1-25, Columns 1-80).
' ErrCode has 3 possible values:::
SELECT CASE ErrCode
CASE IS < 0 'Negative ErrCode means Error (usually -99 or -1)
BEEP
IF ErrCode = -99 THEN '... screen NOT in Library
PRINT TAB(20); "["; ScreenName$; "] was NOT in "; LibName$; ".Psl";
ELSE '... error loading it (probably -1)
PRINT " Error loading "; ScreenName$;
END IF
GOSUB pause
CASE IS >= 0 '...everything went OK
'... Caution: rsScrnRest is ONLY
' for full-width screens.
' Use any screen restore subprogram you want.
CALL rsScrnRest(TopRow%, BotRow%, SEG Array%(1))
ERASE Array% '... no longer needed
GOSUB ShowInfo '... for your information
d$ = INPUT$(1) '... pause
CASE ELSE
END SELECT
'................. ................. ................. .................
RETURN
'................. ................. ................. .................
ShowInfo: '... display info returned by rsLoadScrn
'................. ................. ................. .................
COLOR 0, 7
LOCATE 7, 12: PRINT "┌" + STRING$(54, 196); "┐"
FOR x = 1 TO 8: LOCATE , 12: PRINT "│"; SPC(54); "│": NEXT
LOCATE , 12: PRINT "└" + STRING$(54, 196); "┘"
LOCATE 7, 24: PRINT "rsLoadScrn reported the following:"
LOCATE 9, 16: PRINT " Error Code: "; ErrCode; " It went just fine!"
LOCATE , 16: PRINT " Library: "; LibName$
LOCATE , 16: PRINT " Screen: "; ScreenName$
LOCATE , 16: PRINT " Description: "; Desc$
LOCATE , 16: PRINT " Top Row / Column: "; TopRow; TopCol
LOCATE , 16: PRINT "Bottom Row / Column: "; BotRow; BotCol
LOCATE 16, 31: PRINT "Press a key . . .";
COLOR 7, 0
RETURN
'................. ................. ................. .................
Directory: '... Demonstrate how to review Library Screen Names/Descriptions
'................. ................. ................. .................
CLOSE
OPEN Path$ + LibName$ + ".PSL" FOR RANDOM AS #1 LEN = LEN(ScreenLib)
PRINT TAB(26); "Screens Stored in "; LibName$; ".Psl": PRINT
PRINT TAB(7); "Name"; TAB(17); "Description"; TAB(49); "Name"; TAB(59); "Description"
PRINT
FOR x = 2 TO 51 '... start at record #2
GET #1, x, ScreenLib '... using TYPE format/NOT Field
a$ = LTRIM$(RTRIM$(ScreenLib.ScrName)) '... strip blanks
IF a$ = "" THEN EXIT FOR
PRINT USING " ##. "; x - 1;
PRINT LEFT$(a$ + SPACE$(10), 10); ScreenLib.Description,
NEXT
CLOSE
GOSUB pause
RETURN
'................. ................. ................. .................
pause:
'................. ................. ................. .................
LOCATE 24, 20: PRINT SPC(12); "Press a key . . ."; SPC(15);
a$ = INPUT$(1) '... pause
RETURN
'................. ................. ................. .................
QBDemo: '... Demonstrate displaying screens from an array. The array
' QBMenu%() was loaded with screens from P-Screen.Psl when
' you first ran this --- Call LoadQB (QBMenu%(), QB.ErrCode).
' QBMenu%() needs about 5800 bytes of FAR memory. Loading
' these menus from a screen library into an Integer array
' saves you a few '000 bytes of valuable string/data space.
'NOTE: If strange things happen when you run this, P-Screen.Psl was
' probably altered. The Row/Column and QBMenu% offsets BELOW may no
' longer correspond to where they were loaded.
'................. ................. ................. .................
IF QB.ErrCode <> 0 THEN '... error occurred loading screens
PRINT TAB(12); "Error occurred loading screens earlier. Can't do demo."
BEEP: d$ = INPUT$(1): RETURN
END IF
'...Alt-key scan codes for Alt- : : :
'F (!), E (Chr$(18)), V (/), S (31), R (19), D (" "), O (24), H (#)
AltKey$ = "!/ #" + CHR$(18) + CHR$(31) + CHR$(19) + CHR$(24)
DO '... Outer Loop
CLS
CALL rsScrnRestPlus(SEG QBMenu%(QBMenu%(1)), 1, 1, 1, 80) ' see note below re: Offsets
LOCATE 19, 3: PRINT "This demonstrates displaying menus via an Integer array. These menus are"
LOCATE , 3: PRINT "NOT displayed from disk. They were loaded into QBMenu%() when you ran this."
LOCATE , 3: PRINT "See 'Performance Hints' in your manual. Screens displayed via rsRestPlus."
LOCATE 24, 20: PRINT "Press Alt- F/E/V/S/R/D/O/H [Esc] = Exit";
DO '... get a key
d$ = "": d$ = INKEY$
LOOP WHILE d$ <> CHR$(27) AND LEN(d$) < 2 ' we only want Extended Keys
IF d$ = CHR$(27) THEN EXIT DO '... exit Outer Loop on Esc
d$ = RIGHT$(d$, 1) '... It's Extended, take 2nd key/Strip Chr$(0)
SELECT CASE d$ '... NOTICE: We reserved the 1st 10
' elements in QBMenu%() to store
' the offset into QBMenu% where
' each screen BEGINS.
' See Sub LoadQB for details
CASE "!" '... Alt-F (File)
CALL rsScrnRestPlus(SEG QBMenu%(QBMenu%(2)), 1, 2, 18, 23)
GOSUB pause
CASE CHR$(18) '... Alt-E (Edit)
CALL rsScrnRestPlus(SEG QBMenu%(QBMenu%(3)), 1, 8, 11, 32)
GOSUB pause
CASE "/" '... Alt-V (View)
CALL rsScrnRestPlus(SEG QBMenu%(QBMenu%(4)), 1, 14, 12, 38)
GOSUB pause
CASE CHR$(31) '... Alt-S (Search)
CALL rsScrnRestPlus(SEG QBMenu%(QBMenu%(5)), 1, 20, 8, 47)
GOSUB pause
CASE CHR$(19) '... Alt-R (Run)
CALL rsScrnRestPlus(SEG QBMenu%(QBMenu%(6)), 1, 28, 12, 50)
GOSUB pause
CASE " " '... Alt-D (Debug)
CALL rsScrnRestPlus(SEG QBMenu%(QBMenu%(7)), 1, 33, 16, 63)
GOSUB pause
CASE CHR$(24) '... Alt-O (Options)
CALL rsScrnRestPlus(SEG QBMenu%(QBMenu%(8)), 1, 47, 8, 66)
GOSUB pause
CASE "#" '... Alt-H (Help)
CALL rsScrnRestPlus(SEG QBMenu%(QBMenu%(9)), 1, 52, 7, 80)
GOSUB pause
CASE ELSE 'nada
END SELECT
LOOP
RETURN
'................. ................. ................. .................
CantFindLibrary: '... couldn't find LibName$ + ".Psl"
'................. ................. ................. .................
CLS : CLOSE
PRINT TAB(18); "Can't find "; LibName$ + ".Psl. Press a key . . .";
BEEP: a$ = INPUT$(1): END
'................. ................. ................. .................
MidMessage:
COLOR 0, 7
LOCATE 8, 20: PRINT "┌"; STRING$(39, "─"); "┐"
FOR x = 9 TO 13
LOCATE , 20: PRINT "│"; SPACE$(39); "│"
NEXT
LOCATE , 20: PRINT "└"; STRING$(39, "─"); "┘"
LOCATE 10, 21: PRINT STRING$(38, "─")
LOCATE 9, 22: PRINT a$
LOCATE 14, 22: PRINT "["; c$; "]"
LOCATE 12, 22: PRINT b$;
a$ = "": b$ = "": c$ = ""
COLOR 7, 0
RETURN
'................. ................. ................. .................
SUB LoadQB (QBMenu%(), QB.ErrCode)
'................. ................. ................. .................
' Purpose: 1) Load ALL QB-Type screens from P-Screen.Psl into QBMenu%()
' for fast display later on. Press [Q]B at the menu.
' 2) Demonstrate how to do this in your programs -- for those
' situations needing Instant screens/subscreens
'
' Calls: Run only with LoadScrn.obj & rsLodBin.obj in your Quick Library
'................. ................. ................. .................
'... setup
'................. ................. ................. .................
CLS
REDIM QBMenu%(1 TO 4200) '... Just 4200 bytes FAR memory needed to store
' all qb screens. Saves lots of string space.
' In your programs, you can calculate (4200) on the fly.
REDIM Tmp%(1) '... Temporary storage for each screen
CONST LibNm$ = "P-SCREEN" '... Same Screen Library for all loads.
OffSet = 10 '... Offset into QBMenu% to load each new screen.
' We have 9 screens. Reserve 10 elements to store
' offset of each screen for re-displaying.
ScreenNumber = 1 ' To store Offset for re-displaying screen.
'................. ................. ................. .................
'... start loading screens (1 to 9)
'................. ................. ................. .................
ScrnN$ = "QB-MAIN"
CALL rsLoadScrn(Tmp%(), LibNm$, ScrnN$, Desc$, TopRow, TopCol, BotRow, BotCol, x, ErrCode)
GOSUB CalcOffset
ScrnN$ = "FILE-1"
CALL rsLoadScrn(Tmp%(), LibNm$, ScrnN$, Desc$, TopRow, TopCol, BotRow, BotCol, x, ErrCode)
GOSUB CalcOffset
ScrnN$ = "EDIT-1"
CALL rsLoadScrn(Tmp%(), LibNm$, ScrnN$, Desc$, TopRow, TopCol, BotRow, BotCol, x, ErrCode)
GOSUB CalcOffset
ScrnN$ = "VIEW-1"
CALL rsLoadScrn(Tmp%(), LibNm$, ScrnN$, Desc$, TopRow, TopCol, BotRow, BotCol, x, ErrCode)
GOSUB CalcOffset
ScrnN$ = "SEARCH-1"
CALL rsLoadScrn(Tmp%(), LibNm$, ScrnN$, Desc$, TopRow, TopCol, BotRow, BotCol, x, ErrCode)
GOSUB CalcOffset
ScrnN$ = "RUN-1"
CALL rsLoadScrn(Tmp%(), LibNm$, ScrnN$, Desc$, TopRow, TopCol, BotRow, BotCol, x, ErrCode)
GOSUB CalcOffset
ScrnN$ = "DEBUG-1"
CALL rsLoadScrn(Tmp%(), LibNm$, ScrnN$, Desc$, TopRow, TopCol, BotRow, BotCol, x, ErrCode)
GOSUB CalcOffset
ScrnN$ = "OPTNS-1"
CALL rsLoadScrn(Tmp%(), LibNm$, ScrnN$, Desc$, TopRow, TopCol, BotRow, BotCol, x, ErrCode)
GOSUB CalcOffset
ScrnN$ = "HELP-1"
CALL rsLoadScrn(Tmp%(), LibNm$, ScrnN$, Desc$, TopRow, TopCol, BotRow, BotCol, x, ErrCode)
GOSUB CalcOffset
'... NOTE: UNComment next line (& line near end) if you want to see stats as screens are loaded
''PRINT : PRINT TAB(4); "Press a key . . .";
''d$ = INPUT$(1) 'pause '... see below, if you print stats, pause before exit
'................. ................. ................. .................
EXIT SUB '... all done
'................. ................. ................. .................
'................. ................. ................. .................
CalcOffset: '... this does the actual work: find the right spot
' (Offset) for each new screen, copy screen to QBMenu%,
' then store Offset in QBMenu% for displaying
'................. ................. ................. .................
IF ErrCode < 0 THEN QB.ErrCode = -99: EXIT SUB '...tsk tsk, jumping out of a gosub.
' just for demo. do gracefully in your program.
OffSet = OffSet + ScrnSize '... Offset into QBMenu% to load each new screen.
' Starts = 10; bumped by ScrnSize.
' For 1st screen, ScrnSize = 0 so Offset = 10
ScrnSize = ((BotRow - TopRow) + 1) * ((BotCol - TopCol) + 1)'... Size of this screen
FOR x = 1 TO UBOUND(Tmp%) '... Copy it into QBMenu%
IF x + OffSet > UBOUND(QBMenu%) THEN EXIT FOR '... just in case
QBMenu%(x + OffSet) = Tmp%(x) ' NOTE: 1st screen begins at 11
NEXT ' (Offset+x or 10+1)
QBMenu%(ScreenNumber) = OffSet + 1 '... '+1' because we add x in For..Next
' See QBDemo to see how QBMenu%(1-10) are used.
ScreenNumber = ScreenNumber + 1 '... bump it for the next screen
'... NOTE: UNComment next line (& Pause above) if you want to see stats as screens are loaded
'' PRINT USING " \ \ ##### ##### TopRow, TopCol, BotRow, BotCol ## ## ## ##"; ScrnN$; ScrnSize; OffSet + 1; TopRow; TopCol; BotRow; BotCol
RETURN
END SUB